COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	F A B C D E U W X Y Z P DK INFPRV LENTRY PTWORD PINF LINF NBUFS LPDL PDL DARBLK INFBLK IBUF WRD0 WRD UFDLOP NXTUFD GOTUFD NODISK NODAR NOMFD SIXSML SIXOUT REDPPN REDLOP REDPRG REDADJ CPOPJ GETW2 GETWD NOSUCH PPNOUT ARGHH
C00009 ENDMK
C⊗;
;F A B C D E U W X Y Z P DK INFPRV LENTRY PTWORD PINF LINF NBUFS LPDL PDL DARBLK INFBLK IBUF WRD0 WRD UFDLOP NXTUFD GOTUFD NODISK NODAR NOMFD SIXSML SIXOUT REDPPN REDLOP REDPRG REDADJ CPOPJ GETW2 GETWD NOSUCH PPNOUT ARGHH

	TITLE WRD	Program to let a wizard find out a user's password.

F←0
A←1
B←2
C←3
D←4
E←5
U←12	;User PPN
W←13	;Lookup block
X←14
Y←15
Z←16
P←17

DK←←1	;Disk I/O channel

INFPRV←←20	;Priv needed

LENTRY←←20	;Length of UFD entry
PTWORD←←3	;Word in entry that has the disk pointer

PINF←←13	;Loc of password in retrieval
LINF←←PINF+1	;Amount of retr to read

NBUFS←←=19	;Number of disk input buffers

LPDL←←30
PDL:	BLOCK LPDL

DARBLK:	'GODMOD'
	1		;Disk absolute read
	IOWD LINF,INFBLK ;Amount to read
	0		;Disk address stuffed here

INFBLK:	BLOCK LINF	;Block for data from file
IBUF:	BLOCK 3		;Input buffer header for reading MFD

WRD0:	OUTSTR [ASCIZ/
/]
WRD:	RESET
	MOVE P,[IOWD LPDL,PDL]
	MOVSI A,INFPRV		;Enable needed priv
	SETPRV A,
	TLNN A,INFPRV		;Get it?
	EXIT
	OUTSTR [ASCIZ/User: /]
	PUSHJ P,REDPPN		;Read PPN into U
	 JRST WRD0		;Bad form, try again
	INIT DK,210		;No bad retr errors, wd mode
	 'DSK   '
	 IBUF
	 JRST NODISK
	INBUF DK,NBUFS		;Get input buffers
	MOVE Z,[['  1  1' ↔ 'UFD   ' ↔ 0 ↔ '  1  1'],,W]
	BLT Z,Z			;Get filename of MFD into W thru Z
	LOOKUP DK,W		;Open MFD
	 JRST NOMFD		;Failed!
UFDLOP:	MOVEI D,LENTRY		;Number of words in a UFD entry
	PUSHJ P,GETWD		;Get first word
	CAME A,U		;Is this the UFD we want?
	JRST NXTUFD
	PUSHJ P,GETWD
	HLRZ A,A
	CAIN A,'UFD'		;Really a UFD?
	JRST GOTUFD		;Yes
NXTUFD:	PUSHJ P,GETWD
	JUMPG D,.-1		;Jump if more words in the UFD
	JRST UFDLOP		;Check next entry in MFD

GOTUFD:	PUSHJ P,GETWD
	CAIE D,LENTRY-PTWORD-1	;Is this the pointer entry?
	JUMPG D,GOTUFD
	JUMPLE D,ARGHH		;Can't happen
	MOVEM A,DARBLK+3	;Store disk address for read
	MTAPE DK,DARBLK
	 JRST NODAR		;Failed?
	RELEAS DK,
	HRROI A,[4000,,"H"]	;ESC H to hide
	TTYSET A,
	OUTSTR [ASCIZ/The /]
	PUSHJ P,PPNOUT
	OUTSTR [ASCIZ/ word is /]
	MOVE A,INFBLK+PINF	;Get password
	SETZM INFBLK+PINF	;For good measure
	PUSHJ P,SIXSML
	OUTCHR ["."]
	EXIT

NODISK:	OUTSTR [ASCIZ/??Can't INIT the DSK./]
	EXIT

NODAR:	OUTSTR [ASCIZ/??PSW read failed./]
	EXIT

NOMFD:	OUTSTR [ASCIZ/??Can't LOOKUP MFD./]
	EXIT

SIXSML:	JUMPE A,CPOPJ
	MOVEI B,0
	ROTC A,6
	JUMPE B,SIXSML	;Suppress spaces
	CAIL B,'A'
	CAILE B,'Z'
	SUBI B,40
	ADDI B,100	;Lower case for letters
	OUTCHR B
	JRST SIXSML

REPEAT 0,<
SIXOUT:	JUMPE A,CPOPJ
	MOVEI B,0
	ROTC A,6
	ADDI B,40	;Make into ASCII
	OUTCHR B
	JRST SIXOUT
>;REPEAT 0

REDPPN:	MOVEI U,0	;Collect PPN in U
	MOVE A,[POINT 6,U] ;Byte ptr for collection
	MOVEI B,3	;Max chars in project
REDLOP:	INCHWL C	;Get a char
	TRZE C,600	;Bucky bits are illegal
	POPJ P,		;Bad form
	CAIE C,"["	;Ignore brackets
	CAIN C,"]"
	JRST REDLOP
	CAIN C,15	;Ignore CR
	JRST REDLOP
	CAIN C,12	;LF ends it
	JRST REDADJ	;Justify and return
	CAIN C,","
	JRST REDPRG	;Get programmer now
	SOJL B,REDLOP	;Any more chars allowed?
	TRZ C,40	;Convert to sixbit
	TRZE C,100
	TRO C,40	;Now it's sixbit
	IDPB C,A	;Store sixbit char
	JRST REDLOP

REDPRG:	MOVE A,[POINT 6,U,17] ;Store into right half
	MOVEI B,3
	JRST REDLOP

REDADJ:	HLLZ A,U	;Get project
	SKIPN A		;Skip if any given
	DSKPPN A,	;Get alias PPN
	CAIA
	LSH A,-6	;Right justify half word
	TLNN A,77
	JRST .-2
	HLL U,A
	HRRZ A,U	;Get programmer
	SKIPN A		;Skip if any given
	DSKPPN A,	;Get alias PPN
	CAIA
	LSH A,-6	;Right justify half word
	TRNN A,77
	JRST .-2
	HRR U,A
	AOS (P)
CPOPJ:	POPJ P,

GETW2:	ILDB A,IBUF+1	;Get next word
	SUBI D,1	;Count another word of UFD entry seen
	POPJ P,

GETWD:	SOSG IBUF+2	;Next word from buffer
	IN DK,		;Next buffer
	 JRST GETW2	;OK
	STATO DK,20000
	 OUTSTR [ASCIZ/??Error reading MFD.
/]
	STATZ DK,20000
	 PUSHJ P,NOSUCH	;Tell user PPN not found
	RELEAS DK,
	EXIT

NOSUCH:	OUTSTR [ASCIZ/No user /]
	PUSHJ P,PPNOUT
	OUTCHR ["."]
	POPJ P,

PPNOUT:	HLLZ A,U		;Get project
	PUSHJ P,SIXSML
	OUTCHR [","]
	HRRZ A,U		;Programmer
	JRST SIXSML

ARGHH:	OUTSTR [ASCIZ/??The Impossible error has struck!/]
	RELEAS DK,
	EXIT

	END WRD